/* GUI CONVERTED from rwrodel.p (converter v1.75) Sat Aug 12 23:17:49 2000 */
/* rwrodel.p - ROUTING DELETE/ARCHIVE FUNCTION                          */
/* Copyright 1986-2002 QAD Inc., Carpinteria, CA, USA.                  */
/* All rights reserved worldwide.  This is an unpublished work.         */
/*F0PN*/ /*V8:ConvertMode=FullGUIReport                                 */
/*K1Q4*/ /*V8:RunMode=Character,Windows                                 */
/* REVISION: 6.0      LAST MODIFIED: 09/26/90   BY: emb *               */
/* REVISION: 6.0      LAST MODIFIED: 10/23/90   BY: emb *D128*          */
/* REVISION: 6.0      LAST MODIFIED: 06/03/91   BY: emb *D668*          */
/* REVISION: 7.3      LAST MODIFIED: 05/14/93   BY: qzl *GA89*          */
/* REVISION: 7.3      LAST MODIFIED: 05/14/93   BY: qzl *GB30*          */
/* Oracle changes (share-locks)      09/13/94   BY: rwl *GM49*          */
/* REVISION: 7.3      LAST MODIFIED: 03/09/95   by: srk *G0GN*          */
/* REVISION: 7.3      LAST MODIFIED: 11/27/95   by: bcm *G1F4*          */

/* REVISION: 8.6E     LAST MODIFIED: 02/23/98   BY: *L007* A. Rahane     */
/* REVISION: 8.6E     LAST MODIFIED: 05/20/98   BY: *K1Q4* Alfred Tan    */
/* REVISION: 8.6E     LAST MODIFIED: 08/05/98   BY: *J2TR* Santhosh Nair */
/* REVISION: 8.6E     LAST MODIFIED: 10/04/98   BY: *J314* Alfred Tan    */
/* REVISION: 9.1      LAST MODIFIED: 03/24/00 BY: *N08T* Annasaheb Rahane */
/* REVISION: 9.1      LAST MODIFIED: 08/12/00 BY: *N0KP* myb              */


/*GUI global preprocessor directive settings */
&GLOBAL-DEFINE PP_PGM_RP TRUE
&GLOBAL-DEFINE PP_ENV_GUI TRUE


/*GUI preprocessor directive settings */
&SCOPED-DEFINE PP_GUI_CONVERT_MODE REPORT

/*GB30*/ {mfdtitle.i "b+ "}

/* ********** Begin Translatable Strings Definitions ********* */

&SCOPED-DEFINE rwrodel_p_1 "Delete"
/* MaxLen: Comment: */

&SCOPED-DEFINE rwrodel_p_2 "Archive File"
/* MaxLen: Comment: */

&SCOPED-DEFINE rwrodel_p_3 "Archive"
/* MaxLen: Comment: */

/* ********** End Translatable Strings Definitions ********* */

define variable routing like ro_routing.
define variable yn like mfc_logical.
define variable rdelete like mfc_logical label {&rwrodel_p_1}.
define variable archive like mfc_logical label {&rwrodel_p_3} initial yes.
define variable filename as character format "x(12)" label {&rwrodel_p_2}.
define stream archive.


/*GUI preprocessor Frame A define */
&SCOPED-DEFINE PP_FRAME_NAME A

FORM /*GUI*/ 
   
 RECT-FRAME       AT ROW 1.4 COLUMN 1.25
 RECT-FRAME-LABEL AT ROW 1   COLUMN 3 NO-LABEL
 SKIP(.1)  /*GUI*/
routing        colon 20
   pt_desc1       no-label
   skip(1)
   rdelete        colon 20
   archive        colon 20
   filename       colon 20
 SKIP(.4)  /*GUI*/
with frame a side-labels width 80 attr-space NO-BOX THREE-D /*GUI*/.

 DEFINE VARIABLE F-a-title AS CHARACTER.
 F-a-title = &IF (DEFINED(SELECTION_CRITERIA) = 0)
  &THEN " Selection Criteria "
  &ELSE {&SELECTION_CRITERIA}
  &ENDIF .
 RECT-FRAME-LABEL:SCREEN-VALUE in frame a = F-a-title.
 RECT-FRAME-LABEL:WIDTH-PIXELS in frame a =
  FONT-TABLE:GET-TEXT-WIDTH-PIXELS(
  RECT-FRAME-LABEL:SCREEN-VALUE in frame a + " ", RECT-FRAME-LABEL:FONT).
 RECT-FRAME:HEIGHT-PIXELS in frame a =
  FRAME a:HEIGHT-PIXELS - RECT-FRAME:Y in frame a - 2.
 RECT-FRAME:WIDTH-CHARS IN FRAME a = FRAME a:WIDTH-CHARS - .5. /*GUI*/

/*GUI preprocessor Frame A undefine */
&UNDEFINE PP_FRAME_NAME



/* SET EXTERNAL LABELS */
setFrameLabels(frame a:handle).

/*J2TR*/ /* FILE NAME FORMAT IS CHANGED TO MAINTAIN CONSISTENCY.      */

/*J2TR** filename = "rw" + substring(string(year(today)),3)           */

/*J2TR*/ filename = "rw" + substring(string(year(today),"9999"),3,2)
            + string(month(today),"99")
            + string(day(today),"99")
            + ".hst".


/*GUI*/ {mfguirpa.i true  "printer" 132 }

/*GUI repeat : */
/*GUI*/ procedure p-enable-ui:

/*G0GN*   do on error undo, retry with frame a: */
      output stream archive close.

      display filename with frame a.

      
run p-action-fields (input "display").
run p-action-fields (input "enable").
end procedure. /* p-enable-ui, replacement of Data-Entry GUI*/

/*GUI*/ procedure p-report-quote:


      find pt_mstr where pt_part = routing no-lock no-error.
      if available pt_mstr then
     display pt_part @ routing
        pt_desc1
/*G0GN*/ with frame a.
      else
     display " " @ pt_desc1
/*G0GN*/ with frame a.

      if not can-find(first ro_det where ro_routing = routing) then do:
/*D128*/ {mfmsg.i 126 3} /* Routing does not exist */
/*G0GN*/ /*GUI NEXT-PROMPT removed */
     /*GUI UNDO removed */ RETURN ERROR.
      end.

      if archive then do:

     /* Note: archive files should be backed up and deleted from disk */
     {mfmsg.i 51 1}

     if search(filename) <> ? then do:
        {mfmsg03.i 52 2 filename """" """"}
        /* WARNING: <filename> exists, archive data will be appended */
     end.

      end.

/*D668*/ bcdparm = "".
/*D668*/ {mfquoter.i routing }
/*D668*/ {mfquoter.i rdelete }
/*D668*/ {mfquoter.i archive }

      hide frame b.

      
/*GUI*/ end procedure. /* p-report-quote */
/*GUI - Field Trigger Section */

/*GUI MFSELxxx removed*/
/*GUI*/ procedure p-report:
/*GUI*/   {gpprtrpa.i  "printer" 132}
/*GUI*/   mainloop: do on error undo, return error on endkey undo, return error:
find pt_mstr where pt_part = routing no-lock no-error.



      {mfphead.i}

/*G0GN*   end. */

   if archive then
   output stream archive to value(filename) append.

   for each ro_det where ro_routing = routing
   with frame b width 132 no-attr-space:

      /* SET EXTERNAL LABELS */
      setFrameLabels(frame b:handle).
      display ro_routing ro_op ro_std_op ro_desc ro_wkctr ro_mch WITH STREAM-IO /*GUI*/ .

      if archive then do:
     export stream archive "ro_det".
     export stream archive ro_det.

      end.

/*GA89*/  if rdelete or archive then do:

/*G1F4*/     /*! ARCHIVE/DELETE SIDE-FILE DATA */
/*G1F4*/     for each qad_wkfl where qad_key1 = "ro_det"
/*G1F4*/                                        + string(ro_routing,"x(18)")
/*G1F4*/                                        + string(ro_op,"99999")
/*G1F4*/     exclusive-lock:

/*G1F4*/        if archive then do:
/*G1F4*/           export stream archive "qad_wkfl".
/*G1F4*/           export stream archive qad_wkfl.
/*G1F4*/        end.

/*G1F4*/           if rdelete then
/*G1F4*/        delete qad_wkfl.
/*G1F4*/     end.

/*G1F4*/     /*! ARCHIVE/DELETE COMMENTS */
/*GA89*/     if ro_cmtindx <> 0 then do:
/*GM49*/        for each cmt_det exclusive-lock where cmt_indx = ro_cmtindx:

/*G1F4*/           if archive then do:
/*G1F4*/              export stream archive "cmt_det".
/*G1F4*/              export stream archive cmt_det.
/*G1F4*/           end.

/*G1F4*/           if rdelete then
/*GA89*/              delete cmt_det.
/*GA89*/        end.
/*GA89*/     end.
/*GA89*/ end.

      if rdelete then delete ro_det.
   end.

   output stream archive close.

   
/*GUI*/ {mfguitrl.i} /*Replace mfrtrail*/

/*GUI*/ {mfgrptrm.i} /*Report-to-Window*/


end.

/*GUI*/ end procedure. /*p-report*/
/*GUI*/ {mfguirpb.i &flds=" routing rdelete archive "} /*Drive the Report*/
